.nr PO 0.5i
.nr LL 7.0i
.LP
.bp
.ls 1
.nf
/* Three diferent descriptions of
	calculating maginitude of vector */

/* data flow description */

magasync_dataflow(A,B,Res):-
	#abs_unit(A,Aab),
	#abs_unit(B,Bab),
	#maxmin(Aab,Bab,G,L),
	#calc(G,L,Sqs),
	#delay(G,G1),
	#result(G1,Sqs,Res).

delay(G,G1):-
	@G1 = G.

abs_unit(I,O):-
	(var(I) ;
	if I < 0 then @O = -I else @O = I) .

maxmin(I1,I2,O1,O2):-
	(var(I1) ; var(I2) ;
	if I1 > I2 then (@O1 = I1, @O2 = I2)
		   else (@O1 = I2, @O2 = I1)) .

calc(I1,I2,O):-
	(var(I1) ; var(I2) ;
	@O = I1 * 7 / 8 + I2 / 2) .

result(I1,I2,O):-
	(var(I1) ; var(I2) ;
	if I1 > I2 then @O = I1 else @O = I2) .

test2:- read(Va),read(Vb),input_data(A,Va),input_data(B,Vb),
	magasync_dataflow(A,B,Res), write_fk([A,B,Res]).

Figure (12) Algorithm in Tokiio for figure (11)
.bp
/* algorithmic description */

magasync(A,B,Res):-
	(if A < 0
	   then Aab <- - A
	   else Aab <- A ),
	(if B < 0
	   then Bab <- - B
	   else Bab <- B )
    &&
	(if Aab > Bab
	   then G <- Aab, L <- Bab
	   else G <- Bab, L <- Aab)
    &&
	Sqs <- G * 7 / 8 + L / 2 , G <- G
    &&
	(if G > Sqs
	   then Res <- G
	   else Res <- Sqs).

test1:- read(Va),read(Vb),input_data(A,Va),input_data(B,Vb),
	magasync(A,B,Res), write_fk([A,B,Res]).

Figure (8) Tokiio Program for figure (7)
.bp
/* heads are interval names */

mag_name(A,B,Res) :- int1(A,B,Res).

int1(A,B,Res) :-
	length(1),
	(if A < 0 then Aab <- - A
		  else Aab <- A ),
	(if B < 0 then Bab <- - B
		  else Bab <- B )
    &&  int2(Aab,Bab,Res).

int2(Aab,Bab,Res) :-
	length(1),
	(if Aab > Bab
	   then (G <- Aab, L <- Bab)
	   else (G <- Bab, L <- Aab))
    &&  int3(G,L,Res).

int3(G,L,Res) :-
	length(1),
	Sqs <- G * 7 / 8 + L / 2 , G <- G
    &&  int4(Sqs,G,Res).

int4(Sqs,G,Res) :-
	length(1),
	if G > Sqs
	   then Res <- G
	   else Res <- Sqs.

/* data generator */

input_data(V,[]):-true.
input_data(V,[H|T]):-
	V = H,
	@T = T,
	@input_data(V,T).

write_fk(A) :- fin(write(A)),keep(write(A)).

test3:- read(Va),read(Vb),input_data(A,Va),input_data(B,Vb),
	mag_name(A,B,Res), write_fk([A,B,Res]).

Figure (10) Program Having Interval Names
.bp


store(Adr,Value0,Contents) :-
    Value = Value0,
    Now = Contents,
    prolog(store0(0,Adr,Value,Now,Next)),
    Contents <- Next.

fetch(Adr,Value0,Contents) :-
    Now = Contents,
    prolog(fetch0(0,Adr,Value,Now)),
    stable( Contents ),
    Value0 <- Value.

memory(Adr,Cmd,Data,Contents) :- (
    if Cmd=read       then fetch(Adr,Data,Contents)
    else if Cmd=write then store(Adr,Data,Contents)
    else stable(Contents)) && memory(Adr,Cmd,Data,Contents).

/* Prolog program for decording
    Tokio doesn't have cut */

store0(Adr,Adr,Value,[_|Tail],[Value|Tail]) :- !.
store0(I,  Adr,Value,[V|Now],[V|Next]) :-
    I1 is I+1,
    store0(I1,Adr,Value,Now,Next).

fetch0(Adr,Adr,Value,[Value|_]) :- !.
fetch0(I,  Adr,Value,[_|Now]) :-
    I1 is I+1,
    fetch0(I1,Adr,Value,Now).

test2 :- (
    Cmd=write,Data=1,Adr=0 &&
    Cmd=write,Data=2,Adr=3 &&
    Cmd=off &&
    Cmd=read,Adr=0 &&
    Cmd=off &&
    Cmd=read,Adr=3 &&
    Cmd=off ),
    memory(Adr,Cmd,Data,Contents),
    #write((Adr,Cmd,Data)),#nl.


Figure (14) Memory System in Tokio
.bp

% memory using global variable

global([cmd,adr,data,contents]).

memory :- (
    if *cmd=read       then fetch
    else if *cmd=write then store
    else stable(*contents)) && memory.

store :-
    Value = *data,
    Now = *contents, Adr = *adr, Value = *data,
    prolog(store0(0,Adr,Value,Now,Next)),
    *contents <- Next.

fetch :-
    Adr = *adr, Now = *contents,
    prolog(fetch0(0,Adr,Value,Now)),
    stable( *contents ),
    *data <- Value.


test3 :- (
    *cmd=write,*data=1,*adr=0 &&
    *cmd=write,*data=2,*adr=3 &&
    *cmd=off &&
    *cmd=read,*adr=0 &&
    *cmd=off &&
    *cmd=read,*adr=3 &&
    *cmd=off ),
    memory,
    #{  Adr = *adr, Cmd = *cmd, Data = *data,
	write((Adr,Cmd,Data)),
	nl }.

Figure (15) Memory System Using Global Variables

.bp


:-op(400,xfy,'..').


X..tag :- Tag:: X = (Data,Tag,Map).
X..data :- Data:: X = (Data,Tag,Map).
X..map :- Map:: X = (Data,Tag,Map).

case2(_,[]):- true.
case2(_,[[[otherwise],ActOtherwise]]):- ActOtherwise.
case2([Val01,Val02],[[[Var1,Var2],Act]|Rest]):-
	Val1=Val01,Val2=Val02,
	if (Var1 = [not,Var1N], Var2 = [not, Var2N],
	    Val1 \== Var1N, Val2 \== Var2N)
		then Act
		else
	if (Var1 = [not,Var1N], Var2 = [Var2P],
	    Val1 \== Var1N, Val2 = Var2P)
		then Act
		else
	if (Var1 = [Var1P], Var2 = [not, Var2N],
	    Val1 = Var1P, Val2 \== Var2N)
		then Act
		else
	if (Var1 = [Var1P], Var2 = [Var2P],
	    Val1 = Var1P, Val2 = Var2P)
		then Act
		else case2([Val1,Val2],Rest).

static([
	length,memory(_),
	stack_depth,run,
	return_code,
	d_cell,d_addr,d_mem,
	g_cell,g_addr,g_mem,
	stack_ln(_),
	stack_ga(_),
	stack_da(_)
]).

global([
	g_bus,d_bus
]).

init:-
	*length <= (*memory(*g_addr)..data - 1,'INT',0),
	*d_addr <= (*d_addr..data + 2,'INT',*d_addr..map),
	*g_addr <= (*g_addr..data + 2,'INT',*g_addr..map),
	*stack_depth <= 0,
	*run <= 1
    &&  loop_unif.

	    Figure (16)-1 UP in Tokio
.bp
loop_unif:-
	if *length..data > 0
	    then fetch_unif1
	    else if *stack_depth = 0
	       then ( *return_code <= (0,'INT',0),
		      *run <= 0
			   && idle)
	       else ( *length <= *stack_ln(*stack_depth - 1),
		      *g_addr <= *stack_ga(*stack_depth - 1),
		      *d_addr <= *stack_da(*stack_depth - 1),
		      *stack_depth <= *stack_depth - 1
			   &&  fetch_unif1).

fetch_unif1:-
	 fetch_unif0g,
	 fetch_unif0d &&
	 *length <= (*length..data - 1,'INT',0),
	 *g_addr <= (*g_addr..data + 1,'INT', *g_addr..map),
	 *d_addr <= (*d_addr..data + 1,'INT', *d_addr..map) &&
	 fetch_unif2.

fetch_unif0g:-
	 fetch(*g_cell,*g_addr,*g_bus), *g_mem <= *g_addr  &&
	 if *g_cell..tag = 'VAR'
		then fetch_unif1g.

fetch_unif1g:-
	 fetch(*g_cell,*g_cell,*g_bus), *g_mem <= *g_cell  &&
	 if *g_cell..tag = 'VAR'
		then fetch_unif1g.

fetch_unif0d:-
	 fetch(*d_cell,*d_addr,*d_bus), *d_mem <= *d_addr  &&
	 if *d_cell..tag = 'VAR'
		then fetch_unif1d.

fetch_unif1d:-
	 fetch(*d_cell,*d_cell,*d_bus), *d_mem <= *d_cell  &&
	 if *d_cell..tag = 'VAR'
		then fetch_unif1d.
    
     Figure (16)-2 UP in Tokio
.bp
fetch_unif2:-
	if *g_mem = *d_mem
		then loop_unif
		else case2([*g_cell..tag,*d_cell..tag],
		  [[[['UNDEF'],['UNDEF']],
		    (store(*g_mem,*d_mem, *g_bus) && loop_unif)],
		   [[['UNDEF'],[not,'UNDEF']],
		    (store(*g_mem,*d_cell,*g_bus) && loop_unif)],
		   [[[not,'UNDEF'],['UNDEF']],
		    (store(*d_mem,*g_cell,*d_bus) && loop_unif)],
		   [[['LIST'],['LIST']],
		    (if *length..data > 0
			then ((*stack_depth <= *stack_depth + 1,
			       S<-- *stack_depth,
			       *stack_ga(S) <= *g_addr,
			       *stack_da(S) <= *d_addr,
			       *stack_ln(S) <= *length,
			       *length <= (2,'INT',g),
			       *g_addr <= *g_cell,
			       *d_addr <= *d_cell) && fetch_unif1)
			else loop_unif)],
		   [[otherwise],
		    (if (*g_cell..tag =\= *d_cell..tag ;
			 *g_cell..data =\= *d_cell..data)
		     then ((*return_code <= 'FAIL', *run <= 0)
			       && idle)
		     else loop_unif)]]).

store(Adr,Data,Bus):-
	(Address,_,Map)<--Adr,Map=Bus,
	D = *d_bus,G = *g_bus,
	if D==G
	     then if Bus = d
		then true && store(Adr,Data,Bus)
		else *memory((Address,_,Map)) <= Data
	     else *memory((Address,_,Map)) <= Data.

fetch(Data,Adr,Bus):-
	Adr = (Address,_,Map),Map=Bus,
	D = *d_bus,G = *g_bus,
	if D==G
	     then if Bus = d
		then (true && fetch(Data,Adr,Bus))
		else Data <= *memory((Address,_,Map))
	     else Data <= *memory((Address,_,Map)).

idle:-  dump,
	if *run = 1
		then (true && init).
 
      Figure (16)-1 UP in Tokio
.bp
test:-
	*memory((0,_,g)) := (4,'INT',g),        % length
	*memory((1,_,g)) := (append,'ATOM',g),  %  append
	*memory((2,_,g)) := (100,'LIST',g),
	*memory((3,_,g)) := (200,'LIST',g),
	*memory((4,_,g)) := (300,'VAR',g),
	*memory((5,_,g)) := (2,'INT',g),
	*memory((6,_,g)) := (print,'ATOM',g),   % print
	*memory((7,_,g)) := (400,'VAR',g),
	*memory((8,_,g)) := (0,'INT',g),        % length = 0
	*memory((100,_,g)) := (a,'ATOM',g),
	*memory((101,_,g)) := (102,'LIST',g),
	*memory((102,_,g)) := (b,'ATOM',g),
	*memory((103,_,g)) := ([],'ATOM',g),
	*memory((200,_,g)) := (c,'ATOM',g),
	*memory((201,_,g)) := (102,'LIST',g),
	*memory((202,_,g)) := (d,'ATOM',g),
	*memory((203,_,g)) := ([],'ATOM',g),
	*memory((300,_,g)) := (0,'UNDEF',g),
	*memory((400,_,g)) := (0,'UNDEF',g),
	*memory((0,_,d)) := (5,'INT',d),
	*memory((1,_,d)) := (append,'ATOM',d),  % append([H|X],Y,[H|Z])
	*memory((2,_,d)) := (200,'LIST',d),
	*memory((3,_,d)) := (300,'VAR',d),
	*memory((4,_,d)) := (400,'LIST',d),
	*memory((5,_,d)) := (5,'INT',d),
	*memory((6,_,d)) := (append,'ATOM',d),   % append([],X,X)
	*memory((7,_,d)) := ([],'ATOM',d),
	*memory((8,_,d)) := (100,'VAR',d),
	*memory((9,_,d)) := (100,'VAR',d),
	*memory((100,_,d)) := (0,'UNDEF',d),
	*memory((200,_,d)) := (500,'VAR',d),    % [H|X]
	*memory((201,_,d)) := (600,'VAR',d),
	*memory((300,_,d)) := (0,'UNDEF',d),    % Y
	*memory((400,_,d)) := (700,'LIST',d),   % [H|Z]
	*memory((500,_,d)) := (0,'UNDEF',d),    % H
	*memory((600,_,d)) := (0,'UNDEF',d),    % X
	*memory((700,_,d)) := (500,'VAR',d),    % H
	*memory((701,_,d)) := (800,'VAR',d),    % Z
	*memory((800,_,d)) := (0,'UNDEF',d),    % Z
	*g_addr := (0,'INT',g),
	*d_addr := (0,'INT',d),
	*return_code := (0,'UNDEF',0),
	*length := (0,'INT',0),
	*g_mem := (0,'INT',g),
	*d_mem := (0,'INT',d),
	*g_cell := (0,'INT',g),
	*d_cell := (0,'INT',d),
	*run := 0,
	*stack_depth := 0 &&
	init,
	# print_g((*g_addr, *d_addr, *return_code, *run, *length,
		 *g_mem, *d_mem, *g_cell, *d_cell, *stack_depth,
		 *g_bus, *d_bus)).

print_g(List):-List=List0,write(List0).

 Figure (16)-4 UP in Tokio
